;;;; 2007-02-26 05:35:07
;;;; Behold, the power of lisp.

;(in-package :cse517a-hw2)


;; reads a parenthesis wrapped space delimited file into a two-dimensional list
(defun read-lists (file)
  (let ((lst nil))
    (with-open-file (str file :direction :input)
      (do ((line (read str nil 'eof)
                 (read str nil 'eof)))
        ((eql line 'eof))
        (setf lst (cons line lst))))
    lst))

;; Measures the entropy of a list
(defun entropy (lst)
  (let ((total 0) (entropy 0) (counter (make-hash-table :test #'equal :size 16)))
    (dolist (val lst)
      (setf total (+ 1 total))
      (if (gethash val counter)
          (setf (gethash val counter) (+ 1 (gethash val counter)))
          (setf (gethash val counter) 1)))
    (with-hash-table-iterator (counter-it counter)
      (loop
        (multiple-value-bind (entry-p key value)
          (counter-it)
          (if entry-p
              (if (not (or (equal (hash-table-count counter) 1) (equal (hash-table-count counter) 0)))
                  (setf entropy (- entropy (* (/ value total) (log (/ value total) (hash-table-count counter))))))
              (return)))))
    entropy))

;; Measures the entropy of a for a 2-dimensional list element
(defun nth-entropy (data pred)
  (let ((vals nil))
    (dolist (val data)
      (setf vals (cons (nth pred val) vals)))
    (entropy vals)))

;; node for trees
(defstruct (node (:print-function
                   (lambda (n s d)
                     (format t "#<~a>" (node-attr n)))))
  attr (c (make-hash-table :test #'equal :size 16)))

;; Measures information gain for an attribute
(defun gain (data attr pred)
  (let ((gain (nth-entropy data pred))
        (total 0)
        (counter (make-hash-table :test #'equal :size 16)))
    (dolist (val data)
      (setf total (+ 1 total))
      (setf (gethash (nth attr val) counter) (cons (nth pred val) (gethash (nth attr val) counter))))
    (with-hash-table-iterator (counter-it counter)
      (loop
        (multiple-value-bind (entry-p key value)
          (counter-it)
          (if entry-p
              (setf gain (- gain (* (/ (length value) total) (entropy value))))
              (return gain)))))))

;; Determines which element is the best in terms of information gain
(defun amax (data avail pred)
  (let ((best-key nil) (best-val -1e38) (val nil))
    (dolist (cur avail)
      (setf val (gain data cur pred))
      (if (> val best-val)
          (progn
            (setf best-val val)
            (setf best-key cur))))
    best-key))

;; Creates a tree
(defun id3-recurse (data names avail pred)
  (if (null avail)
      (nth pred (car data))
      (let* ((split (amax data avail pred))
             (sub-data (make-hash-table :test #'equal :size 16))
             (result (make-node :attr (nth split names))))
        (dolist (val data)
          (setf (gethash (nth split val) sub-data) (cons val (gethash (nth split val) sub-data))))
        (with-hash-table-iterator (sub-data-it sub-data)
          (loop
            (multiple-value-bind (entry-p key value)
              (sub-data-it)
              (if entry-p
                  (if (equal 0 (nth-entropy value pred))
                      (setf (gethash key (node-c result)) (nth pred (car value)))
                      (setf (gethash key (node-c result)) (id3-recurse value names (remove split avail) pred)))
                  (return)))))
        result)))
  
;; Prints a tree
(defun print-tree (tree &optional (depth 0))
  (dotimes (i depth) (format t " "))
  (format t "~A~%" (node-attr tree))
  (with-hash-table-iterator (sub-it (node-c tree))
      (loop
        (multiple-value-bind (entry-p key value)
          (sub-it)
          (if entry-p
              (if (node-p value)
                  (progn
                    (dotimes (i (+ 2 depth)) (format t " "))
                    (format t "= ~A~%" key)
                    (print-tree value (+ 3 depth)))
                  (progn
                    (dotimes (i (+ 2 depth)) (format t " "))
                    (format t "= ~A => ~A~%" key value)))
              (return))))))

;; Predicts the value of the data
(defun tree-predict (tree data names)
  (if (position (node-attr tree) names)
      (let* ((val (gethash (nth (position (node-attr tree) names) data) (node-c tree)))
             (result val))
        (if (node-p val)
            (progn
              (setf result (tree-predict val data names))
              (if (null result)
                  val
                  result))
            val))
      nil))
  
;; Randomly takes an element from a list
(defun random-elt (choices)
  (elt choices (random (length choices))))

;; Folds the lst into folds the size of n
(defun nfold (lst n)
  (let ((dlst lst) (folds (list )))
    (loop
      (when (= (length dlst) 0)
        (return folds))
      (setf folds (cons (list ) folds))
      (dotimes (i n)
        (when (= (length dlst) 0)
          (return folds))
        (setf (car folds) (cons (random-elt dlst) (car folds)))
        (setf dlst (remove (car (car folds)) dlst))))))


;; Folds the lst into folds the size of n and conses the fold with the not folds
(defun nfold-with-set (lst n)
  (let ((folds (nfold lst n)) (dlst nil))
    (progn
      (dotimes (i (length folds))
        (setf dlst lst)
        (dolist (val (nth i folds))
          (setf dlst (remove val dlst)))
        (setf (nth i folds) (cons (nth i folds) dlst)))
      folds)))

;; Folds the list into portions, so 10 portions, portion = 0.1
(defun portion-nfold (lst portion)
  (nfold lst (ceiling (* (length lst) portion))))

;; Folds the list into portions with not in set conses, so 10 portions, portion = 0.1
(defun portion-nfold-with-set (lst portion)
  (nfold-with-set lst (ceiling (* (length lst) portion))))

;; Returns the ratio of correct to test-size
(defun build-test-tree (build-data test-data names avail pred)
  (let ((tree (id3-recurse build-data names avail pred))
        (tested 0)
        (correct 0))
    (dolist (val test-data)
      (setf tested (+ 1 tested))
      (if (equal (tree-predict tree val names) (nth pred val))
          (setf correct (+ 1 correct))))
    ;; build length : test length : correct
    (format t "~A : ~A : ~A~%" (length build-data) (length test-data) correct)
    (/ correct (length test-data))))
    

#|
Useful statements

;; Tennis data setup
(setf tennis-names '(outlook temperature humidity wind play))
(setf tennis (read-lists "C:/programming/data/tennis.data"))

;; Tennis test

(dotimes (i 2)
  (format t "Run: ~A~%" i)
  (setf cur 0)
  (dolist (c (portion-nfold-with-set tennis 0.1))
    (format t "Fold: ~A~%" cur)
    (setf cur (1+ cur))
    (setf tennis-tree (id3-recurse tennis tennis-names '(0 1 2 3) 4))
    (format t "Result: =~A =~A ~A~%" (test-bayes 'YES (cdr c) tennis-test-table 4) (car tennis-test-table) (cadr tennis-test-table)))))

;; Tennis tree
(setf tennis-tree (id3-recurse tennis tennis-names '(0 1 2 3) 4))
(print-tree tennis-tree)


;; Mushroom data setup
(setf shroom-avail '(1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22))
(setf shroom-data (read-lists "C:/programming/data/agaricus-lepiota.data"))
(setf shroom-names (car (read-lists "C:/programming/data/agaricus-lepiota.names-list")))

;; Building a tree on whole data set
(setf shroom-tree (id3-recurse shroom-data shroom-names shroom-avail 0))
(print-tree shroom-tree)

;; Creating folds
(setf shroom-folds (portion-nfold-with-set shroom-data 0.1))

;; Testing of the first fold
(setf shroom-tree-0 (id3-recurse (cdr (nth 0 shroom-folds)) shroom-names shroom-avail 0))
(tree-predict shroom-tree-0 (nth 0 (car (nth 0 shroom-folds))) shroom-names)

;; predict
(dolist (var (car (nth 0 shroom-folds)))
(format t "~A " (tree-predict shroom-tree-0 var shroom-names)))

;;actual
(dolist (var (car (nth 0 shroom-folds)))
(format t "~A " (nth 0 var)))


;; Primary test
(let ((result 0))
  (dolist (cur shroom-folds)
    (setf result (+ result (build-test-tree (cdr cur) (car cur) shroom-names votes-avail 0))))
  (/ result (length shroom-folds)))

;; Opposite test, using the small set as training and the large set as test
(let ((result 0))
  (dolist (cur shroom-folds)
    (setf result (+ result (build-test-tree (car cur) (cdr cur) shroom-names votes-avail 0))))
  (/ result (length shroom-folds)))

;; Breast Cancer Data Setup
(setf cancer-avail '(1 2 3 4 5 6 7 8 9))
(setf cancer-data (read-lists "C:/programming/data/breast-cancer.data"))
(setf cancer-names (car (read-lists "C:/programming/data/breast-cancer.names-list")))

;; Single tree
(setf cancer-tree (id3-recurse cancer-data cancer-names cancer-avail 0))

;;Breast cancer testing
(setf cancer-folds (portion-nfold-with-set cancer-data 0.1))
(let ((result 0))
  (dolist (cur cancer-folds)
    (setf result (+ result (build-test-tree (cdr cur) (car cur) cancer-names cancer-avail 0))))
  (/ result (length cancer-folds)))


;; House Votes Data Setup
(setf votes-avail '(1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16))
(setf votes-data (read-lists "C:/programming/data/house-votes-84.data"))
(setf votes-names (car (read-lists "C:/programming/data/house-votes-84.names-list")))

;; Single tree
(setf votes-tree (id3-recurse votes-data votes-names votes-avail 0))
(print-tree votes-tree)

;;House Votes testing
(setf votes-folds (portion-nfold-with-set votes-data 0.1))
(let ((result 0))
  (dolist (cur votes-folds)
    (setf result (+ result (build-test-tree (cdr cur) (car cur) votes-names votes-avail 0))))
  (/ result (length votes-folds)))

|#

